Лабораторна робота №2. Маніпулювання даними

Мета: Засвоєння принципів, знайомвство з інструментами та набуття навичок манпулювання даними (wrangle) засобами мови програмування R та колекції пакетів tidyvers.

Імпорт даних

# install_formats() #інсталяція додаткових компонентів пакету rio

library(rio)
df <- data.frame(x = 1:5, y = rnorm(5))

export(df, "data/df_data_frame.txt")
dfImp <- import("data/df_data_frame.txt")
dfImp

data("mtcars") #підключення стандартного набору даних mtcars
# head(mtcars)
export(head(mtcars), "data/mtcars.dta")
convert('data/mtcars.dta', 'data/mtcars.csv')
import("data/mtcars.csv")

Імпорт з реляційних баз даних

#install.packages("dbplyr")
#install.packages("RSQLite")

library(dbplyr)
library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:dbplyr':

    ident, sql

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(RSQLite)

# my_db <- src_sqlite("data/my_db.sqlite3", create = T)
#head(my_db)

#install.packages("nycflights13")
library(nycflights13)
# flights_sqlite <- copy_to(my_db, flights, temporary = FALSE, 
#                           indexes = list(c("year", "month", "day"), "carrier", "tailnum"))
# head(flights_sqlite)

con <- DBI::dbConnect(RSQLite::SQLite(), path = "data/my_db.sqlite3")
flights_sqlite <- copy_to(con, nycflights13::flights, "flights",
        temporary = FALSE, 
        indexes = list(
          c("year", "month", "day"), 
          "carrier", 
          "tailnum",
          "dest"
        )
)

head(flights_sqlite)

DBI::dbDisconnect(con)

Приведення даних до охайного вигляду

#install.packages("tidyverse")
library(tidyverse)

Warning: package 'ggplot2' was built under R version 4.4.2

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ forcats   1.0.0     ✔ readr     2.1.5
✔ ggplot2   3.5.1     ✔ stringr   1.5.1
✔ lubridate 1.9.3     ✔ tibble    3.2.1
✔ purrr     1.0.2     ✔ tidyr     1.3.1
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::ident()  masks dbplyr::ident()
✖ dplyr::lag()    masks stats::lag()
✖ dplyr::sql()    masks dbplyr::sql()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

# відносний критерій на 10000
table1 %>%  # стандартний набір даних
  mutate(rate = cases / population * 10000) # обчислення нового поля

# кількість випадків на рік
table1 %>% 
  count(year, wt = cases)

# Візуалізація динаміки зміни кількості випадків з часом
library(ggplot2)

ggplot(table1, aes(year, cases)) + 
  geom_line(aes(group = country), colour = "white") + 
  geom_point(aes(colour = country))+
  theme_dark()

Завдання на самостійну роботу.

Побудувати динаміку відносного критерію rate кількості захворювань по роках для кожної держави.

table1 %>%  # стандартний набір даних
  mutate(rate = cases / population * 10000) |> 
  ggplot(aes(year, rate)) +
  geom_line(aes(group = country), colour = "white") + 
  geom_point(aes(colour = country))+
  theme_dark()

Gathering

table4a

table4a %>% 
  gather(`1999`, `2000`, key = "year", value = "cases")

tidy4a <- table4a %>% 
  gather(`1999`, `2000`, key = "year", value = "cases")
tidy4b <- table4b %>% 
  gather(`1999`, `2000`, key = "year", value = "population")
dplyr::left_join(tidy4a, tidy4b)

Joining with `by = join_by(country, year)`

Завдання на самостійну роботу

Виконати попереднє завдання, базуючись на таблицях tidy4a і tidy4b з використанням потокового оператора.

dplyr::left_join(table4a |> 
                  gather(`1999`, `2000`, key = "year", value = "cases")
                 ,table4b |> 
                   gather(`1999`, `2000`, key = "year", value = "population")) |> 
  mutate(rate = cases / population * 10000) |> 
  ggplot(aes(year, rate)) +
  geom_line(aes(group = country), colour = "white") + 
  geom_point(aes(colour = country))+
  theme_dark()

Joining with `by = join_by(country, year)`

Spreading

table2

table2 %>%
    spread(key = type, value = count)

Separating

table3

table3 %>% 
  separate(rate, into = c("cases", "population"))

Uniting

table5

table5 %>% 
  unite(year, century, year, sep = "")

Пропущені значення

Пропущені значення (missing value) у наборах даних можуть бути двох видів: явні (позначені як NA, Not Available) і неявні (просто не представлені у даних). Такі дані називаються некомплектні.
Нижче наведено приклад, який це ілюструє.

stocks <- tibble(
  year   = c(2015, 2015, 2015, 2015, 2016, 2016, 2016),
  qtr    = c(   1,    2,    3,    4,    2,    3,    4),
  return = c(1.88, 0.59, 0.35,   NA, 0.92, 0.17, 2.66)
)
stocks

Дані за четвертий квартал 2015 явно відсутні про що свідчить відповідне значення. Дані за перший квартал не внесені у таблицю, тобто відсутні неявно, але відсутність можна помітити після відповідної траснформації.

stocks %>% 
  spread(year, return)

Виявити множину некомплектних даних можна також з використанням функції complete().

stocks %>% 
  complete(year, qtr)

Проблема некомплектних даних вирішується двома шляхами: виключенням некомплектних спостережень, або імпутацією пропущених значень іншими значеннями, виходячи з певної моделі.

stocks %>% 
  spread(year, return) %>% 
  gather(year, return, `2015`:`2016`, na.rm = TRUE)

У випадках, коли це доцільно, можна використовувати функцію fill(), яка заповнює пропущенні значення, взявши значення з останньої заповненої клітинки:

df <- data.frame(Month = 1:12, Year = c(2000, rep(NA, 11)))
df

df %>% fill(Year)

Трансформація

# Вибірка рядків таблиці
library(dplyr)

starwars %>% 
  filter(species == "Droid")

# Вибірка полів таблиці
starwars %>% 
  select(name, ends_with("color"))

# Створення нового поля у таблиці з послідуючою вибіркою
starwars %>% 
  mutate(name, bmi = mass / ((height / 100)  ^ 2)) %>%
  select(name:mass, bmi)

# Сортування даних
starwars %>% 
  arrange(desc(mass))

# Обчислення агрегатів з попереднім групуванням по полю species
starwars %>%
  group_by(species) %>%
  summarise(
    n = n(),
    mass = mean(mass, na.rm = TRUE)
  ) %>%
  filter(n > 1)

Індивідуальне завдання

library(readxl)
library(dplyr)
library(plotly)

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:rio':

    export

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

library(DT)
library(lubridate)

# Завантаження даних із очищеного Excel файлу
data <- read_excel("cleaned_currency_data.xlsx")

# Додаємо колонку з місяцем для середньомісячних значень
data <- data %>% mutate(місяць = floor_date(Дата, "month"))

# Розрахунок середньомісячних курсів
monthly_avg <- data %>%
  group_by(місяць) %>%
  summarise(
    USD_UAH_avg = mean(USD_UAH, na.rm = TRUE),
    EUR_UAH_avg = mean(EUR_UAH, na.rm = TRUE),
    RUB_UAH_avg = mean(RUB_UAH, na.rm = TRUE)
  )

# Інтерактивна таблиця щоденних курсів
daily_table <- datatable(data, options = list(pageLength = 10, autoWidth = TRUE))

# Інтерактивна таблиця середньомісячних курсів
monthly_table <- datatable(monthly_avg, options = list(pageLength = 10, autoWidth = TRUE))

# Інтерактивний графік щоденних курсів
daily_plot <- plot_ly(data, x = ~Дата) %>%
  add_lines(y = ~USD_UAH, name = "USD/UAH") %>%
  add_lines(y = ~EUR_UAH, name = "EUR/UAH") %>%
  add_lines(y = ~RUB_UAH, name = "RUB/UAH") %>%
  layout(title = "Щоденна динаміка курсів валют", xaxis = list(title = "Дата"), yaxis = list(title = "Курс"))

# Інтерактивний графік середньомісячних курсів
monthly_plot <- plot_ly(monthly_avg, x = ~місяць) %>%
  add_lines(y = ~USD_UAH_avg, name = "USD/UAH") %>%
  add_lines(y = ~EUR_UAH_avg, name = "EUR/UAH") %>%
  add_lines(y = ~RUB_UAH_avg, name = "RUB/UAH") %>%
  layout(title = "Середньомісячна динаміка курсів валют", xaxis = list(title = "Місяць"), yaxis = list(title = "Середній курс"))

# Виведення таблиць і графіків
print(daily_table)
print(monthly_table)
daily_plot

monthly_plot